;;#lang scheme

;; License: MIT License
;; Author: majid khosravi
;; Website: http://www.majidkhosravi.com

;; include this library to use hash tables
;;(require (lib "69.ss" "srfi"))
(require 'srfi-69 'srfi-1 'srfi-13 'tcp 'srfi-18)
(define cria-mud
  (lambda (in out)
    (let (
          ;; room descriptions association list
          (descriptions '( (1 "You are in the West Jungle, Available directions are 'North' and 'East'")
                           (2 "Jungle, Available directions are 'West' and 'East'")
                           (3 "East Jungle, You can see a house on East, Available directions are 'West', 'North' and 'East'")
                           (4 "You are in a house, There is a door to 'West'")
                           (5 "River way, There is a way to Jungle on 'South' and a house is showing to 'North'")
                           (6 "You are in a House, There is a door to 'North'")
                           (7 "Mountain Road, Jungle is at 'South' and Mountain is to 'North'")
                           (8 "You are in a house, There is a door to 'North'")
                           (9 "You are in a house, There is a door to 'South'")
                           (10 "South River, There is a way to the 'North' and a house to 'South'")
                           (11 "Mountain, There is a way to 'North' and a Road at 'South'")
                           (12 "East Road, There is a road to 'North' and a house at 'South' ")
                           (13 "You are in a house, There is a door to 'North'")
                           (14 "North River, There is a way to 'North' and a road to 'South'")
                           (15 "Desert Road, Mountains are to 'South' and There is a road to 'East'")
                           (16 "East Cottage, Mountain is to 'West', a road to 'South' and a Cave with a door to 'North'")
                           (17 "Castle Doorway, There is a door to 'North' and a End road to 'South', Tunnel is to 'East'")
                           (18 "Tunnel Doorway, There is a way to 'South' and 'West', Tunnel is to 'East'")
                           (19 "Tunnel, Cave door is to 'East' and there is a way to 'West'")
                           (20 "Cave, There is a tunnel to the 'West'")
                           (21 "Castle Yard, There is a door to outside located to 'West' and there is a door to 'East'")
                           (22 "Castle Hallway, There is a door to castle yard to 'West' and a door to 'East'")
                           (23 "Castle Hall, Hallway is to 'West' and jail is to 'East'")
                           (24 "Jail, You found the Queen and rescued her!!!")))

          ;; rooms directions
          (directions '( (1 (north 5) (south 0) (west 0) (east 2))
                         (2 (north 0) (south 0) (west 1) (east 3))
                         (3 (north 7) (south 0) (west 2) (east 4))
                         (4 (north 0) (south 0) (west 3) (east 0))
                         (5 (north 9) (south 1) (west 0) (east 0))
                         (6 (north 10) (south 0) (west 0) (east 0))
                         (7 (north 11) (south 3) (west 0) (east 0))
                         (8 (north 12) (south 0) (west 0) (east 0))
                         (9 (north 0) (south 5) (west 0) (east 0))
                         (10 (north 14) (south 6) (west 0) (east 0))
                         (11 (north 15) (south 7) (west 0) (east 0))
                         (12 (north 16) (south 8) (west 0) (east 0))
                         (13 (north 17) (south 0) (west 0) (east 0))
                         (14 (north 18) (south 10) (west 0) (east 0))
                         (15 (north 0) (south 11) (west 0) (east 16))
                         (16 (north 20) (south 12) (west 15) (east 0))
                         (17 (north 21) (south 13) (west 0) (east 18))
                         (18 (north 0) (south 14) (west 17) (east 19))
                         (19 (north 0) (south 0) (west 18) (east 20))
                         (20 (north 0) (south 16) (west 19) (east 0))
                         (21 (north 0) (south 17) (west 0) (east 22))
                         (22 (north 0) (south 0) (west 21) (east 23))
                         (23 (north 0) (south 0) (west 22) (east 24))
                         (24 (north 0) (south 0) (west 23) (east 0))))


          ;; rooms properties
          (rooms-list '( (1 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (2 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (3 (locked #f) (key #f) (dagger #f) (enemy #t) (potion #f) (end #f))
                         (4 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #t) (end #f))
                         (5 (locked #f) (key #f) (dagger #t) (enemy #f) (potion #f) (end #f))
                         (6 (locked #f) (key #t) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (7 (locked #t) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (8 (locked #f) (key #t) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (9 (locked #f) (key #t) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (10 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (11 (locked #f) (key #f) (dagger #f) (enemy #t) (potion #f) (end #f))
                         (12 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (13 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (14 (locked #f) (key #f) (dagger #f) (enemy #t) (potion #f) (end #f))
                         (15 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (16 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (17 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (18 (locked #f) (key #f) (dagger #f) (enemy #t) (potion #f) (end #f))
                         (19 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (20 (locked #t) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (21 (locked #t) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (22 (locked #f) (key #f) (dagger #f) (enemy #t) (potion #f) (end #f))
                         (23 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #f))
                         (24 (locked #f) (key #f) (dagger #f) (enemy #f) (potion #f) (end #t))))

          ; now load rooms-list in to the rooms hash table
          (roomsdb (make-hash-table))

          ; room items descriptions
          (game-texts '((welcome " --={ Welcome to FOHN (Fable of One Hand Ninja)  }=--\n --={ You need to find the Queen which is jailed in a castle to win the game!  }=--")
                        (dagger "There is a 'Dagger' in this room, type 'take' to take it")
                        (no-dagger "You do not have any Daggers to fight with")
                        (locked "This door is locked, type 'open' to open the door")
                        (key "There is a 'Key' in this room, type 'pick' to pick it up")
                        (enemy "There is an 'Enemy' in this room, type 'fight' to fight with enemy")
                        (potion "There is a 'Health Potion' in this room, type 'collect' to take it")
                        (enemy-nodagger "You do not have a Dagger to fight with enemy")
                        (no-key "You do not have any key to open this room")
                        (lock-open "You have used your key and this room is now open")
                        (pick "You have picked up the key in this room")
                        (pick-error "There is no key in this room to pickup")
                        (take "You have taken a dagger in this room")
                        (take-error "There is no dagger in this room")
                        (fight "You have killed the enemy")
                        (fight-error "There is no enemy to fight")
                        (collect "You have collected the health potion in this room.")
                        (collect-error "There is no health potion to collect.")
                        (open "You have used a key and opened the door")
                        (open-error "This door is not locked")
                        (heal-no-potion "You do not have any health potion to heal yourself")
                        (heal "You have healed yourself, your life is back to 100 now")
                        (health-full "Your life is 100%, you do not need to heal yourself now")
                        (enemy-warning "You should kill the enemy first")
                        (enemy-attack "Enemy attacked you and you lost 20% of your life")
                        (player-died "You are dead!")
                        (you-won "You Won, you have reached the destination")))
          ;; create a new hash table for attributes of the player
          (player (make-hash-table))
          (self-in in)
          (self-out out))

      (hash-table-set! player 0 '(1 (keys 0)(dagger 0) (potion 0) (life 100)))

      ;; loop through all items self-in the rooms-list and insert them into the hash table
      (for-each (lambda (x)
                  (hash-table-set! roomsdb (car x) (cdr x))) rooms-list)
      (letrec ((self
                (lambda (selector)
                  (cond
                   ((eq? selector 'replace-room-item)
                    ;; returns a new list by replacing item with new value self-in the given list
                    (lambda (list item new-value)
                      (cond
                       ((null? list) (quote()))
                       (else (cond
                              ((eq? (caar list) item)
                               (cons new-value (cdr list)))
                              (else (cons (car list)
                                          ((self 'replace-room-item) (cdr list) item new-value))))))))

                   ;; update a player attribute by given key and new value
                   ((eq? selector 'player-update)
                    (lambda (key value)
                      (hash-table-set! player 0 (cons '1 ((self 'replace-room-item)  (cdr (hash-table-ref player 0)) key value)))))

                   ;; gets list self-in the asociacion list by id
                   ((eq? selector 'assq-ref)
                    (lambda (assqlist id)
                      (cdr (assq id assqlist))))

                   ;; get an attribute of the player by given key
                   ((eq? selector 'player-attribute)
                    (lambda (key)
                      (car ((self 'assq-ref) (cdr (hash-table-ref player 0)) key))))

                   ;; increase a value of player attribute
                   ((eq? selector 'player-add-value)
                    (lambda (key value)
                      (let ((new-value (+ ((self 'player-attribute) key) value)))
                        ((self 'player-update) key (list key new-value)))))

                   ;; prints player items
                   ((eq? selector 'player-status)
                    (lambda (self-out)
		      (display (format "\n  ==[  ") self-out)
		      (for-each (lambda (x) (display (format "~a: ~a  " (car x) (cadr x)) self-out) ) (cdr (hash-table-ref player 0)))
                      (display (format "]==\n") self-out)))

                   ;; Get an attribute self-in the given asociacion list by id
                   ((eq? selector 'lookup)
                    (lambda (data room-id attribute)
                      (car ((self 'assq-ref) ((self 'assq-ref) data room-id) attribute))))

                   ;; gets the room description by given id
                   ((eq? selector 'get-room-description)
                    (lambda (rid)
                      (car ((self 'assq-ref) descriptions rid))))

                   ;; returns a text description of the item self-in the roomsdb
                   ((eq? selector 'describe)
                    (lambda (item)
                      (format "~a" (car ((self 'assq-ref) game-texts item)))))

                   ;; get available directions
                   ((eq? selector 'get-available-directions)
                    (lambda (rid)
                      (let ((direction ((self 'assq-ref) directions rid)))
                        (map car (filter (lambda (x) (> (second x) 0)) direction)))))

                   ;; checks roomsdb hash table and returns value of an attribute self-in the roomsdb
                   ((eq? selector 'get-room-item)
                    (lambda (id field)
                      (if (hash-table-exists? roomsdb id)
                          (let ((record (hash-table-ref roomsdb id)))
                            (if (memq field '(locked key dagger enemy potion end))
                                (cadr (assq field record))
                                "wrong field type"))
                          "no such room")))

                   ;; gets locked doors self-in the given room
                   ((eq? selector 'get-locked-room)
                    (lambda (rid)
                      (filter
                       (lambda (x) ((self 'get-room-item) x 'locked))
                       (map (lambda (x) ((self 'lookup) directions rid x ))  ((self 'get-available-directions) rid)))))

                   ; returns a command depending on the item self-in the room
                   ((eq? selector 'map-item-command)
                    (lambda (item)
                      (if (eq? item 'locked)
                          'open
                          (if (eq? item 'key)
                              'pick
                              (if (eq? item 'dagger)
                                  'take
                                  (if (eq? item 'potion)
                                      'collect
                                      (when( eq? item 'enemy)
                                        'fight)))))))

                   ;; checks roomsdb and returns the list with given room id
                   ((eq? selector 'get-room)
                    (lambda (id)
                      (if (hash-table-exists? roomsdb id)
                          (hash-table-ref roomsdb id)
                          "no such room")))

                   ;; returns all available items self-in the given room id
                   ((eq? selector 'get-available-items)
                    (lambda (rid)
                      (let ((direction ((self 'get-room) rid)))
                        (map car (filter (lambda (x) (eq? (second x) #t)) direction)))))

                   ; returns a list of available commands depending on the roomsdb attributes
                   ((eq? selector 'get-available-commands)
                    (lambda (rid)
                      (let ((l (map (self 'map-item-command) ((self 'get-available-items) rid))))
                        (cons 'heal (if ( > (length ((self 'get-locked-room) rid)) 0)
                                        (cons 'open l)
                                        l)))))

                   ;;;;print available commands and directions self-in the given room
                   ;;(define (print-available-commands rid self-out)
                   ;;  (display (format "\n========[  ") self-out)
                   ;;  (for-each (lambda (x) (display (format "~a  " x) self-out)) (append (get-available-directions rid) (get-available-commands rid)))
                   ;;  (display (format "]========\n") self-out))

                   ;; print available commands and directions self-in the given room
                   ((eq? selector 'print-available-commands)
                    (lambda (rid self-out)
                      (display (format "\n========[  ") self-out)
                      (for-each (lambda (x) (display (format "~a  " x) self-out)) (append ((self 'get-available-directions) rid) ((self 'get-available-commands) rid)))
                      (display (format "]========\n") self-out)))

                   ;; returns all available items self-in the given room id
                   ((eq? selector 'get-available-items)
                    (lambda (rid)
                      (let ((direction ((self 'get-room) rid)))
                        (map car (filter (lambda (x) (eq? (second x) #t)) direction)))))

                   ;; process the given command self-in the given room, updates rooms hash table if necessary
                   ((eq? selector 'process-command)
                    (lambda (cmd rid self-out)
                      (cond
                       ;; open the door
                       ((equal? cmd 'open)
                        (if (> (length ((self 'get-locked-room) rid)) 0)
                            (if (> ((self 'player-attribute) 'keys) 0)
                                (begin
                                  (let ((target-room (car ((self 'get-locked-room) rid))))
                                    (hash-table-set! roomsdb target-room ((self 'replace-room-item) ((self 'get-room) target-room) 'locked '(locked #f)))
                                    ((self 'player-add-value) 'keys -1)
                                    (display ((self 'describe) 'open) self-out)))
                                (display ((self 'describe) 'no-key) self-out))
                            (display ((self 'describe) 'open-error) self-out)))

                       ;; pick up the key self-in the room
                       ((equal? cmd 'pick)
                        (if ((self 'get-room-item) rid 'key)
                            (begin
                              (hash-table-set! roomsdb rid ((self 'replace-room-item) ((self 'get-room) rid) 'key '(key #f)))
                              ((self 'player-add-value) 'keys 1)
                              (display ((self 'describe) 'pick) self-out))
                            (display ((self 'describe) 'pick-error) self-out)))

                       ;; take the dagger self-in the room
                       ((equal? cmd 'take)
                        (if ((self 'get-room-item) rid 'dagger)
                            (begin
                              (hash-table-set! roomsdb rid ((self 'replace-room-item) ((self 'get-room) rid) 'dagger '(dagger #f)))
                              (display ((self 'describe) 'take) self-out)
                              ((self 'player-update) 'dagger '(dagger 1)))
                            (display ((self 'describe) 'take-error) self-out)))

                       ;; process fight command
                       ((equal? cmd 'fight)
                        (if ((self 'get-room-item) rid 'enemy)
                            (begin
                              (if (eq? ((self 'player-attribute) 'dagger) 1)
                                  (begin
                                    (hash-table-set! roomsdb rid ((self 'replace-room-item) ((self 'get-room) rid) 'enemy '(enemy #f)))
                                    (display ((self 'describe) 'fight) self-out))
                                  (display ((self 'describe) 'no-dagger) self-out)))
                            (display ((self 'describe) 'fight-error) self-out)))

                       ;; collect health potion
                       ((equal? cmd 'collect)
                        (if ((self 'get-room-item) rid 'potion)
                            (begin
                              (hash-table-set! roomsdb rid ((self 'replace-room-item) ((self 'get-room) rid) 'potion '(potion #f)))
                              ((self 'player-add-value) 'potion 1)
                              (display ((self 'describe) 'collect) self-out))
                            (display ((self 'describe) 'collect-error) self-out)))

                       ;; heal the player
                       ((equal? cmd 'heal)
                        (if (> ((self 'player-attribute) 'potion) 0)
                            (if(< ((self 'player-attribute) 'life) 100)
                                (begin
                                  ((self 'player-add-value) 'potion -1)
                                  ((self 'player-update) 'life '(life 100))
                                  (display ((self 'describe) 'heal) self-out))
                                (display ((self 'describe) 'health-full) self-out))
                            (display ((self 'describe) 'heal-no-potion) self-out)))

                       ;; invalid selection
                       (else
                        ;(display (format "invalid command") self-out)
                        (display (format "invalid command") self-out)))))

                   ;; start the game from given room
                   ((eq? selector 'startgame)
                    (lambda (room-id self-in self-out)
                      (display ((self 'describe) 'welcome) self-out)
                      (let loop ((rid room-id) (echo #t))
                        (display (format "") self-out)

                        ;; when there is an enemy self-in the room
                        (when ((self 'get-room-item) rid 'enemy)
                          (begin
                            (display ((self 'describe) 'enemy-attack) self-out)
                            ((self 'player-add-value) 'life -20)))

                        ;; print self-out player items
                        ((self 'player-status) self-out)

                        ;; when you reach the destination
                        (when ((self 'get-room-item) rid 'end)
                          (begin
                            (display ((self 'describe) 'you-won) self-out)
                            (exit)))

                        ;; print room description and available items
                        (when echo
                          (display (format "--<([  ~a  ])>--" ((self 'get-room-description) rid)) self-out)
                          (display "\n" self-out)
                          (map (lambda (x) (display ((self 'describe) x) self-out)) ((self 'get-available-items) rid)))

                        ;; When player life is equal or less than 0, exit the loop with player dead message
                        (when (<= ((self 'player-attribute) 'life) 0)
                          (begin
                            (display ((self 'describe) 'player-died) self-out)
                            (exit)))

                        ;; print self-out all available commands
                        ((self 'print-available-commands) rid self-out)
                        (write-line "> " self-out)

			;; read a character, convert it to string and then lower case and then convert back to a symbol
                        (let ((input (string->symbol (string-downcase (symbol->string (read self-in))))))
			  ;;(let ((input (string->symbol (string-downcase (symbol->string (read self-in))))))

                          ;; if command is quit, exit the loop
                          (if (eq? input 'quit) (exit) 'continue)

                          ;; check if given command is self-in available directions
                          (if (member input ((self 'get-available-directions) rid))
                              (let ((direction ((self 'lookup) directions rid input)))
                                (if (zero? direction)
                                    (loop rid #f)

                                    ;; do not allow player to move away from the room if there is an enemy there
                                    (if ((self 'get-room-item) rid 'enemy)
                                        (begin
                                          (display ((self 'describe) 'enemy-warning) self-out)
                                          (loop rid #f))

                                        ;; check if the destination room is locked    
                                        (if ((self 'get-room-item) direction 'locked)
                                            (begin
                                              (display ((self 'describe) 'locked) self-out)
                                              (loop rid #f))

                                            ;; if it is not locked, go to the destination
                                            (loop direction #t)))))

                              ;; check if the command is self-in the available commands list
                              (if (member input ((self 'get-available-commands) rid))
                                  (begin
                                    ((self 'process-command) input rid self-out)
                                    (loop rid #f))

                                  ;; display a message if the command is not valid
                                  (begin
                                    (display (format " ~a is an Invalid command!" input) self-out)
                                    (loop rid #f))))))))
                   ))))
        ((self 'startgame) 1 self-in self-out)))))




